home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 1327 / refcount.dpr < prev    next >
Text File  |  1997-06-26  |  4KB  |  122 lines
  1. {******************************************************}
  2. { RefCount v1.0                                        }
  3. { Copyright (c) 1997 Magnus BΣck                       }
  4. { baeck@swipnet.se                                     }
  5. {******************************************************}
  6. { This software may be distributed and modified freely }
  7. { as long as the original copyright is not removed and }
  8. { no profit is made from it.                           }
  9. {******************************************************}
  10.  
  11. program RefCount;
  12.  
  13. uses SysUtils,
  14.   Classes,
  15.   Registry,
  16.   Windows;
  17.  
  18. {$R *.RES}
  19.  
  20. {$R RC_RES.RES}
  21.  
  22. {$APPTYPE CONSOLE}
  23.  
  24. const
  25.     ProductName    = 'RefCount';
  26.     Version        = 'v1.0';
  27.     Copyright        = 'Copyright (c) 1997 Magnus Bäck';
  28. var
  29.     CalculatedParamCount, CurrData, I, J: Integer;
  30.     Registry: TRegistry;
  31.     Values: TStringList;
  32.     CurrValue: string;
  33.     BinaryData: array [0..3] of Char;
  34.     PrintedLine, DoAll, DoClean: Boolean;
  35. begin
  36.     if ParamCount = 0 then
  37.     begin
  38.         Writeln(Format('%s %s %s',[ProductName,Version,Copyright]));
  39.         Writeln;
  40.         Writeln('Syntax: REFCOUNT.EXE [/CLEAN] {/ALL | <filename> ...}');
  41.         Writeln;
  42.         Writeln('Use:    Returns the system reference count of <filename>.');
  43.         Writeln('        This is stored in the registry in');
  44.         Writeln('        HKML\SOFTWARE\Microsoft\Windows\CurrentVersion\' +
  45.             'SharedDLLs.');
  46.         Writeln('        /CLEAN also removes all zero reference counts');
  47.         Writeln('        while /ALL displays all values.');
  48.         Halt(1);
  49.     end;
  50.     DoAll := False;
  51.     DoClean := False;
  52.     for I := 1 to ParamCount do
  53.     begin
  54.         if AnsiLowerCase(ParamStr(I)) = '/clean' then
  55.             DoClean := True;
  56.         if AnsiLowerCase(ParamStr(I)) = '/all' then
  57.             DoAll := True;
  58.     end;
  59.     Registry := TRegistry.Create;
  60.     try
  61.         Registry.RootKey := HKEY_LOCAL_MACHINE;
  62.         if not Registry.OpenKey('SOFTWARE\Microsoft\Windows\' +
  63.             'CurrentVersion\SharedDLLs',False) then
  64.         begin
  65.             Writeln('Error: Could not open key HKLM\SOFTWARE\Microsoft\'+
  66.                 'Windows\CurrentVersion\SharedDLLs');
  67.             Halt(1);
  68.         end;
  69.         Values := TStringList.Create;
  70.         try
  71.             Registry.GetValueNames(Values);
  72.             if DoAll then
  73.                 CalculatedParamCount := ParamCount + 1
  74.             else
  75.                 CalculatedParamCount := ParamCount;
  76.             for I := 1 to CalculatedParamCount do
  77.             begin
  78.                 if (AnsiLowerCase(ParamStr(I)) = '/clean') or
  79.                     (AnsiLowerCase(ParamStr(I)) = '/all') then
  80.                     Continue;
  81.                 J := 0;
  82.                 while J < Values.Count do
  83.                 begin
  84.                     PrintedLine := False;
  85.                     CurrValue := Values[J];
  86.                     case Registry.GetDataType(CurrValue) of
  87.                         rdInteger: CurrData := Registry.ReadInteger(CurrValue);
  88.                         rdString:  CurrData := StrToInt(Registry.ReadString(CurrValue));
  89.                         rdBinary:
  90.                         begin
  91.                             Registry.ReadBinaryData(CurrValue,BinaryData,4);
  92.                             CurrData := Ord(BinaryData[0]);
  93.                         end;
  94.                     end;
  95.                     if DoAll or ((ExtractFilePath(ParamStr(I)) = '') and
  96.                         (AnsiLowerCase(ExtractFileName(CurrValue)) =
  97.                         AnsiLowerCase(ParamStr(I)))) or
  98.                         ((ExtractFilePath(ParamStr(I)) <> '') and
  99.                         (AnsiLowerCase(CurrValue) = AnsiLowerCase(ParamStr(I)))) then
  100.                     begin
  101.                         Write(Format('%-60s %-2d (0x%1:.4x)',[CurrValue,CurrData]));
  102.                         PrintedLine := True;
  103.                     end;
  104.                     if DoClean and PrintedLine and (not FileExists(CurrValue)) then
  105.                     begin
  106.                         Registry.DeleteValue(CurrValue);
  107.                         Write(' Deleted');
  108.                     end
  109.                     else if PrintedLine then
  110.                         Writeln;
  111.                     Inc(J);
  112.                 end;
  113.             end;
  114.         finally
  115.             Values.Free;
  116.         end;
  117.     finally
  118.         Registry.CloseKey;
  119.         Registry.Free;
  120.     end;
  121. end.
  122.